home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_pr4.lha / st80_pre4 / MoDE / MMSOuterEnv-Shan.st < prev    next >
Text File  |  1993-07-24  |  8KB  |  247 lines
  1. StandardSystemController subclass: #MMSStdSysController
  2.     instanceVariableNames: 'rootMode '
  3.     classVariableNames: ''
  4.     poolDictionaries: ''
  5.     category: 'MMSOuterEnv-Shan'!
  6. MMSStdSysController comment:
  7. 'I detect the cursor actions.  When I should be active, I turn on the event generation, activate the rootModeProcess and then monitor the cursor action every 250 msec.  When I go off, I stop the event generation and suspend the rootModeProcess.'!
  8.  
  9.  
  10. !MMSStdSysController methodsFor: 'control defaults'!
  11.  
  12. controlActivity
  13.     sensor blueButtonPressed & self viewHasCursor
  14.         ifTrue: 
  15.             [self eventQueue disable.
  16.             self blueButtonActivity.
  17.             self eventQueue enable]! !
  18.  
  19. !MMSStdSysController methodsFor: 'private'!
  20.  
  21. rootMode: rMode 
  22.     "This is to support the Smalltalk 'collapse' and 'expand' window 
  23.     management.  The implementation of these two message changes the 
  24.     firstSubView of my view.  Therefore I have to avoid accessing the 
  25.     rootMode (which is stored as the first subView in my view) by doing 
  26.     'self view firstSubView.'  The way I get around it is to have an 
  27.     instance variable that points to the rootMode.  Shan April 26, 1989"
  28.  
  29.     rootMode _ rMode! !
  30.  
  31. !MMSStdSysController methodsFor: 'tracking/replay'!
  32.  
  33. eventQueue
  34.     "Shan 13 July 1990"
  35.  
  36.     ^view firstSubView eventQueue! !
  37.  
  38. !MMSStdSysController methodsFor: 'basic control sequence'!
  39.  
  40. controlLoop
  41.     "Add exception handling. Shan November 17, 1989"
  42.  
  43.     | sc |
  44.     sc _ SignalCollection new.
  45.     "Catch all signals. There are problems with Ctrl-C. When the user 
  46.     selects proceed, the eventQ is still asleep. He needs to go to 
  47.     another window then come back. Make sure not to land right back 
  48.     to the event-driven window after proceeding."
  49.     sc add: Object errorSignal; add: Object userInterruptSignal.
  50.     sc
  51.         handle: 
  52.             [:ex | 
  53.             self eventQueue disable.    "Pretent I have done nothing and let the debugger take over 
  54.             as usual."
  55.             ex reject]
  56.         do: [self realControlLoop]!
  57.  
  58. controlTerminate
  59.     "Shan 19 July 1990"
  60.  
  61.     | terminateBlock |
  62.     terminateBlock _ view firstSubView terminateBlock.
  63.     terminateBlock notNil ifTrue: [terminateBlock value].
  64.     super controlTerminate!
  65.  
  66. realControlLoop
  67.     "Resume the production of events when enter; suspend it when leave."
  68.     "This also allows more than one MMS sessions runing at the same      
  69.      time without worrying who gets the next event."
  70.     "Change the name to add in the Exception-Handling stuffs.  Shan November 18, 1989"
  71.  
  72.     |  event eq |
  73.     eq _ self eventQueue.  "Shan 13 July 1990"
  74.     (eq isKindOf: TREventQueue) ifTrue:[eq rootModeOrigin: view displayBox origin]. "Shan 20 July 1990"
  75.     eq enable.
  76.     "To spy, put the last bracket of 'MessageTally spyOn: []' after the   
  77.     'eq disable'.  As I tried it today, most of the time are spent on   
  78.     meaningful executions.  Less than 5 % overhead for event-driven."
  79.     [self isControlActive]
  80.         whileTrue: 
  81.             [self controlActivity. "Processor yield."
  82.             "This is the place we merge the polling loop with the event     
  83.              procesing loop."
  84.             event _ eq nextWithCursorMoveCompressed. "Shan 25 May 1990"
  85.             rootMode processEvent: event.
  86.             "Generate leaveMode event for the rootMode."
  87.             event selector = #cursorMove ifTrue: [self checkLeaveRootMode: event].
  88.             "event free.  Shan 20 July 1990"
  89.             ].
  90.     eq disable.
  91.     eq flush! !
  92.  
  93. !MMSStdSysController methodsFor: 'enter/leaveEvent-process'!
  94.  
  95. checkLeaveRootMode: event 
  96.     "This method checks if the cursor has moved out of the root mode.  If  
  97.        yes, it informs the rootMode to process the generated leaveMode   
  98.       
  99.     event."
  100.     "Shan March 15, 1989"
  101.  
  102.     | leaveEvent temp |
  103.     (rootMode containsPoint: event origin)
  104.         ifTrue: [^self]
  105.         ifFalse: ["(rootMode containsPoint: event extent)"
  106.             "Shan July 19, 1989"
  107.             rootMode cursorIn
  108.                 ifTrue: 
  109.                     ["construct the leaveMode event and send it."
  110.                     leaveEvent _ event copy.
  111.                     temp _ leaveEvent origin.
  112.                     leaveEvent origin: event previousOrigin.
  113.                     leaveEvent previousOrigin: temp.
  114.                     "See the comment in Mode>processEnterLeave:.  Shan 
  115.                     July 19, 1989"
  116.                     leaveEvent selector: #leaveMode.
  117.                     rootMode processLeave: leaveEvent]]! !
  118.  
  119. !MMSStdSysController methodsFor: 'scheduling'!
  120.  
  121. open
  122.     "Shan Mrach 15, 1989"
  123.  
  124.     view window: view window viewport: (sensor cursorPoint extent: view minimumSize).
  125.     status _ #open.
  126.     self moveOpened.
  127.     self trackFrame.
  128.     "Enforce the view's window and viewport to have same size.  Shan 
  129.     March 25, 1989"
  130.     "view matchWindowAndViewport. This is done automatically when the 
  131.     method 'window: viewport:' is executed.  Shan April 26, 1989"
  132.     "Now we know the absolute position of the rootMode and can start  
  133.     computing the laying relation."
  134.     view firstSubView computeLayering.
  135.     ScheduledControllers scheduleActive: self! !
  136.  
  137. !MMSStdSysController methodsFor: 'menu messages'!
  138.  
  139. collapse
  140.     rootMode unMap.
  141.     super collapse!
  142.  
  143. expand
  144.     "The 'enable' message to the EventQ is in pair with the 'disable' 
  145.     message in the 'collapse' method.  Shane April 26, 1989"
  146.  
  147.     super expand.
  148.     rootMode map!
  149.  
  150. frame
  151.     view erase.
  152.     self moveOpened.
  153.     self trackFrame.
  154.     rootMode computeLayering.
  155.     view displayEmphasized!
  156.  
  157. move
  158.     view erase.
  159.     view isCollapsed 
  160.         ifTrue: [self moveIcon]
  161.         ifFalse: [self moveOpened].
  162.     rootMode computeLayering.
  163.     view displayEmphasized!
  164.  
  165. newLabel
  166.     self eventQueue disable.
  167.     super newLabel.
  168.     self eventQueue enable! !
  169.  
  170. StandardSystemView subclass: #MMSStdSysView
  171.     instanceVariableNames: 'rootModeProcess '
  172.     classVariableNames: ''
  173.     poolDictionaries: ''
  174.     category: 'MMSOuterEnv-Shan'!
  175.  
  176.  
  177. !MMSStdSysView methodsFor: 'controller access '!
  178.  
  179. defaultControllerClass
  180.     ^MMSStdSysController! !
  181.  
  182. !MMSStdSysView methodsFor: 'transforming'!
  183.  
  184. window: w viewport: v 
  185.     "This is for the purpose of resizing.  Shan April 26, 1989"
  186.  
  187.     super window: w viewport: v.
  188.     self matchWindowAndViewport! !
  189.  
  190. !MMSStdSysView methodsFor: 'window/viewport matching'!
  191.  
  192. matchWindowAndViewport
  193.     "This will make the absolute specification of mode size possible.  Shan  
  194.     March 25, 1989"
  195.  
  196.     | rMode ext |
  197.     ext _ self viewport extent.
  198.     "Make the window and viewport the same size.  Don't send the 
  199.     message to self since the 'window: viewport:' method defined in this 
  200.     class makes use of this method.  Infinite loop will happen.   Shan April 
  201.     26, 1989"
  202.     super window: (0 @ 0 extent: ext)
  203.         viewport: self viewport.
  204.     "Make the extents of the window and viewport of root mode  
  205.     equivalent to ext."
  206.     rMode _ self firstSubView.
  207.     rMode window: (0 @ 0 extent: ext)
  208.         viewport: (0 @ 0 extent: ext)! !
  209.  
  210. !MMSStdSysView methodsFor: 'initialize-release'!
  211.  
  212. initialize
  213.     "Make the borderWidth 2 so that the display of border is handled here 
  214.     instead of in RootMode which will introduce a black flash.  (The 
  215.     drawing algorithm fills the whole rectangle with the borderColor then 
  216.     fills the insideColor.)  Shan August 14, 1989"
  217.  
  218.     super initialize.
  219.     self borderWidth: 2! !
  220. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  221.  
  222. MMSStdSysView class
  223.     instanceVariableNames: ''!
  224.  
  225.  
  226. !MMSStdSysView class methodsFor: 'MMS start up'!
  227.  
  228. startUp: aRootMode 
  229.     "Set up the environment for the aRootMode."
  230.     "Set up the InputState1 to generate events"
  231.  
  232.     | mmsTopView |
  233.     "InputState1 replaceSystemInputState. Shan 11 June 1990"
  234.     mmsTopView _ MMSStdSysView new.
  235.     mmsTopView addSubView: aRootMode.
  236.     aRootMode label notNil
  237.         ifTrue: [mmsTopView label: aRootMode label]
  238.         ifFalse: [mmsTopView label: 'MMS application'].
  239.     aRootMode minimumSize notNil
  240.         ifTrue: [mmsTopView minimumSize: aRootMode minimumSize]
  241.         ifFalse: [mmsTopView minimumSize: 400 @ 300].
  242.     "Tracking and replay.  There may be a cleaner way for this.  Shan 18 July 1990"
  243.     (EventQ isKindOf: TREventQueue) ifTrue: [mmsTopView controller: MMSStdSysController1 new].
  244.     mmsTopView controller rootMode: aRootMode.
  245.     "After this the next statement won't be executed.  It is like the C   
  246.     exec() system call."
  247.     mmsTopView controller open! !